home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / pavt150.zip / DHOOKS.INC < prev    next >
Text File  |  1993-04-12  |  7KB  |  245 lines
  1. { Include file for the demo programs in PAvatar. }
  2. { These are the video and user hook routines     }
  3.  
  4. type
  5.   ScreenWord = record
  6.     chr  : char;
  7.     attr : byte;
  8.   end;
  9.   ScreenPtr = ^Screen;
  10.   Screen = Array[1..25,1..80] of ScreenWord;
  11.  
  12. var
  13.   ScrPtr : ScreenPtr; { pointer to the screen for direct writes }
  14.  
  15. {$IFNDEF DPMI}
  16. const  { constants found in TP 7.0 }
  17.   SegB000 = $B000;
  18.   SegB800 = $B800;
  19. {$ENDIF}
  20.  
  21. {$IFDEF DPMI} {$DEFINE VER55} {$ENDIF}
  22. {$IFDEF VER55}         { TP 5.5 & DPMI version }
  23. Function DV_Get_Video_Buffer(cseg:word): word;
  24. begin
  25.   if DESQview_version = 0 then DV_Get_Video_Buffer := cseg
  26.    else
  27.     InLine(
  28.       $b4/$fe/    {  MOV    AH,0FEH          DV's get video buffer function }
  29.       $cd/$10/    {  INT    10H              Returns ES:DI of alt buffer }
  30.       $8c/$c0);   {  MOV    AX,ES            Return video buffer }
  31. end; { DV_Get_Video_Buffer }
  32. {$ELSE}
  33. Function DV_Get_Video_Buffer(cseg:word): word; assembler;
  34. asm
  35.   MOV    ES,cseg            { Put current segment into ES }
  36.   CALL   DESQview_version   { Returns AX=0 if not in DV }
  37.   TEST   AX,AX              { In DV? }
  38.   JZ     @DVGVB_X           { Jump if not }
  39.   MOV    AH,0FEH            { DV's get video buffer function }
  40.   INT    10H                { Returns ES:DI of alt buffer }
  41.   MOV    AX,ES              { Return video buffer }
  42.   JMP    @DVGVB_E           { Exit and return DV buffer }
  43. @DVGVB_X:
  44.   MOV    AX,cseg            { Load old buffer for return to caller }
  45. @DVGVB_E:
  46. end; { DV_Get_Video_Buffer }
  47. {$ENDIF}
  48. {$IFDEF DPMI} {$UNDEF VER55} {$ENDIF}
  49.  
  50. Procedure SetScrPtr;
  51. var
  52.   sg : word;
  53. begin
  54.   if LastMode = 7 then sg := SegB000  { Monochrome video buffer }
  55.     else sg := SegB800;               { Color video buffer }
  56.   sg := DV_Get_Video_Buffer(sg);
  57.   ScrPtr := Ptr(sg,$0000);
  58. end;
  59.  
  60. (* Hooks *)
  61.  
  62. { Identical to FillChar but fills with word values }
  63. procedure FillWord(var x; count:integer; w:word);
  64. begin
  65.   Inline(
  66.   $c4/$be/x/
  67.   $8b/$86/w/
  68.   $8b/$8e/count/
  69.   $fc/
  70.   $f2/$ab);
  71. (*  LES  DI,x              { load target address }
  72.   MOV  AX,w              { load word to fill in }
  73.   MOV  CX,count          { number of words to move }
  74.   CLD                    { clear direction flag }
  75.   REPNZ STOSW            { copy the data } *)
  76. end;
  77.  
  78. {$IFNDEF VER55}
  79. { Identical to Move but moves words instead of bytes (faster) }
  80. procedure MoveW(var Source, Dest; count:integer); assembler;
  81. asm
  82.   MOV  DX,DS           { Save DS }
  83.   LES  DI,Dest         { Load destination ptr }
  84.   LDS  SI,Source       { load source ptr }
  85.   MOV  CX,Count        { load # of words to move }
  86.   CLD
  87.   CMP  SI,DI           { are they overlapping? }
  88.   JNB  @move           { no, do foward }
  89.   MOV  BX,CX           { yes, do backward }
  90.   SHL  BX,1            { count to bytes }
  91.   DEC  BX              { prep for addition }
  92.   DEC  BX
  93.   ADD  SI,BX           { set them to end of area to move }
  94.   ADD  DI,BX
  95.   STD                  { other direction }
  96. @move:
  97.   REP  MOVSW           { move 'em }
  98.   MOV  DS,DX           { restore DS }
  99. end;
  100. {$ELSE}
  101. procedure MoveW(var Source, Dest; count:integer);
  102. begin
  103.   Move(Source, Dest, count * 2); { a SLOW kludge but it will work }
  104. end;
  105. {$ENDIF}
  106.  
  107. procedure GetXY(var x,y:byte);
  108. begin
  109.   x := WhereX;
  110.   y := WhereY;
  111. end;
  112.  
  113. {$F+}
  114. procedure SetXY(x,y:byte);
  115. begin
  116.   GotoXY(x,y);
  117. end;
  118.  
  119. procedure WriteAT(x,y,a:byte;ch:char);
  120. begin  { Write char ch on the screen at x,y using attribute a }
  121.   with ScrPtr^[y,x] do begin
  122.     attr := a;
  123.     chr := ch;
  124.   end;
  125. end;
  126.  
  127. procedure FillArea(x1,y1,x2,y2,a:byte;ch:char);
  128. var  { Fill the screen area with char ch and attribute a }
  129.   sw : screenword;
  130.   w : byte;
  131. begin
  132.   if x1 > x2 then x1 := x2;
  133.   if y1 > y2 then y1 := y2;
  134.   sw.chr := ch;
  135.   sw.attr := a;
  136.   w := succ(x2-x1);
  137.   for y1 := y1 to y2 do
  138.    FillWord(ScrPtr^[y1,x1],w,word(sw));
  139. end;
  140.  
  141. procedure Scroll(dir,x1,y1,x2,y2,n,a:byte);
  142. var  { Scroll scrn area dir (1=up,2=dn,3=lt,4=rt) n lines, fill with color a }
  143.   t : byte;
  144. begin
  145.   if x1 > x2 then x1 := x2;
  146.   if y1 > y2 then y1 := y2;
  147.   if n = 0 then begin
  148.     FillArea(x1,y1,x2,y2,a,' ');
  149.     exit;
  150.   end;
  151.   case dir of
  152.     1 : begin { up }
  153.           if n > succ(y2-y1) then n := succ(y2-y1);
  154.           for t := y1+n to y2 do
  155.            MoveW(ScrPtr^[t,x1], ScrPtr^[t-n,x1], succ(x2-x1)); { move a line }
  156.           FillArea(x1,succ(y2-n),x2,y2,a,' ');
  157.         end;
  158.     2 : begin { down }
  159.           if n > succ(y2-y1) then n := succ(y2-y1);
  160.           for t := y2-n downto y1 do
  161.            MoveW(ScrPtr^[t,x1], ScrPtr^[t+n,x1], succ(x2-x1)); { move a line }
  162.           FillArea(x1,y1,x2,pred(y1+n),a,' ');
  163.         end;
  164.     3 : begin { left }
  165.           if n > succ(x2-x1) then n := succ(x2-x1);
  166.           for t := y1 to y2 do
  167.            MoveW(ScrPtr^[t,x1+n], ScrPtr^[t,x1], succ(x2-(x1+n)));
  168.           FillArea(succ(x2-n),y1,x2,y2,a,' ');
  169.         end;
  170.     4 : begin { right }
  171.           if n > succ(x2-x1) then n := succ(x2-x1);
  172.           for t := y1 to y2 do
  173.            MoveW(ScrPtr^[t,x1], ScrPtr^[t,x1+n], succ(x2-(x1+n)));
  174.           FillArea(x1,y1,pred(x1+n),y2,a,' ');
  175.         end;
  176.   end; { case dir }
  177. end;
  178.  
  179. procedure GetScrChar(x,y:byte;var a:byte;var c:char);
  180. begin  { retrieve the character and attribute on the screen at x,y }
  181.   with ScrPtr^[y,x] do begin
  182.     a := attr;
  183.     c := chr;
  184.   end;
  185. end;
  186.  
  187. procedure HighArea(x1,y1,x2,y2,a:byte);
  188. var  { change the attribute of the screen area to a }
  189.   i,j,m : byte;
  190.   c : char;
  191. begin  { Note, this is a slow kludge }
  192.   if x1 > x2 then x1 := x2;
  193.   if y1 > y2 then y1 := y2;
  194.   for i := x1 to x2 do
  195.    for j := y1 to y2 do begin
  196.      GetScrChar(i,j,m,c);
  197.      WriteAT(i,j,a,c);
  198.    end;
  199. end;
  200.  
  201. procedure Pause(tens:word);
  202. begin  { delay for tens 10ths of a second, abort delay if a key is pressed }
  203.   for tens := tens downto 1 do begin
  204.      DelayTicks(2); { not wonderful accuracy but it works }
  205.      if KeyPressed then tens := 1; { abort the pause }
  206.   end;
  207. end;
  208.  
  209. Procedure ShapeCursor(typ:byte);
  210.  
  211.  procedure SetCursor(shape:word);
  212.  begin
  213.    Inline($b4/$01/        { MOV  AH, 01    }
  214.           $8b/$8e/shape/  { MOV  CX, shape }
  215.           $cd/$10);       { INT  10h       }
  216.  end;
  217.  
  218. begin
  219.   case typ of
  220.     NormCursor   : SetCursor(Def_Cursor);
  221.     BigCursor    : if lo(Def_Cursor) > 7 then SetCursor($000e) { Mono / EGA }
  222.                     else SetCursor($0007); { CGA, yuck! }
  223.     HiddenCursor : SetCursor($0100);
  224.   end;
  225. end;
  226.  
  227. {$F-}
  228.  
  229. (* End Hook Definitions *)
  230.  
  231. procedure SetHooks;
  232. begin
  233. { Query_Hook := <defualt null hook for this application> }
  234.   Pauseh := Pause;
  235.   HighAreah := HighArea;
  236.   GetATh := GetScrChar;
  237.   FillAreah := FillArea;
  238.   Scrollh := Scroll;
  239.   GotoXYh := SetXY;
  240.   WriteATh := WriteAT;
  241. { FlushInputh := <defualt null hook is fine for the demo> }
  242.   Cursorh := ShapeCursor;
  243. end;
  244.  
  245.